home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #22 (1994-01-19)(Diesel)(DE)[WB].zip / Purity #22 (1994-01-19)(Diesel)(DE)[WB].adf / Cryptor / Cryptor.p < prev    next >
Text File  |  1994-01-17  |  3KB  |  152 lines
  1. { ****** Auto-Revision (do NOT edit) ********************
  2.   *
  3.   * © Copyright by BOMBERSOFT
  4.   *
  5.   * Filename          : Pascal:Quellcodes/Cryptor.p
  6.   * Created on        : 19.12.1993
  7.   * Created by        : Björn Schotte
  8.   * Current revision  : V1.10
  9.   *
  10.   *
  11.   * Purpose: De-/Kodieren von Dateien
  12.   *
  13.   *
  14.   * V1.10  : 19.12.1993 : Nochmal etwas überarbeitet 
  15.   *                       (Öffnen-Prozedur geschrieben).
  16.   *
  17.   * V0.000 : 19.12.1993 : - Initial release -
  18.   ******************************************************* }
  19.  
  20. {$Incl "CLI.i",
  21.        "libraries/dos.h"}
  22.  
  23. CONST
  24.   fe = #27"[1m";
  25.   ku = #27"[3m";
  26.   un = #27"[4m";
  27.   no = #27"[0m";
  28.   ora= #27"[33m";
  29.   sc = #27"[31m";
  30.  
  31. VAR
  32.   code    : LongInt;
  33.   i       : Integer;
  34.   f,f1    : Text;
  35.   c       : Char;
  36.   x       : Integer;
  37.   args    : Array[1..4] Of String[80];
  38.   decode  : Boolean;
  39.  
  40. {*********************************************************
  41.  ** Kreiert den Code, indem es zum Code den ASCII-Code  **
  42.  ** jedes einzelnen Zeichens des Passworts dazuaddiert  **
  43.  ** und dann nochmal die Länge des Passworts.           **
  44.  *********************************************************}
  45. FUNCTION FormPasswort(passwort:STRING) : LONGINT;
  46. VAR
  47.   code : LongInt;
  48. BEGIN
  49.   code := 0;
  50.   FOR i:=1 TO length(passwort) DO
  51.     code := code+Ord(passwort[i]);
  52.   code := code + Length(passwort);
  53.   FormPasswort := code;
  54. END;
  55.  
  56. {*********************************************************
  57.  ** Öffnet die Dateien.                                 **
  58.  *********************************************************}
  59. PROCEDURE Öffnen(source, ziel : STRING);
  60. BEGIN
  61.   Reset(f, source);
  62.   IF IOResult = 0 THEN
  63.   BEGIN
  64.     ReWrite(f1, ziel);
  65.     IF IOResult = 0 THEN
  66.     BEGIN
  67.       Buffer(f, 10000);
  68.     END ELSE
  69.     BEGIN
  70.       Close(f);
  71.       Writeln("Kann die Datei '",ziel,"' nicht anlegen !!");
  72.       HALT(20);
  73.     END;
  74.   END ELSE
  75.   BEGIN
  76.     Writeln("Kann die Datei '",source,"' nicht öffnen !!!");
  77.     HALT(20);
  78.   END;
  79. END;
  80.  
  81. PROCEDURE Codiere(passwort,source,ziel : String);
  82. BEGIN
  83.   code := FormPasswort(passwort);
  84.   Öffnen(source, ziel);
  85.   WHILE NOT Eof(f) DO
  86.   BEGIN
  87.     Read(f,c); (* Zeichen lesen *)
  88.     x:=Ord(c); (* ASCII-Code *)
  89.     x:=x+code; (* Code dazuaddieren *)
  90.     REPEAT
  91.      (* x > 255 ? Dann 255 abziehen *)
  92.      If x>255 Then x:=x-255;
  93.     UNTIL x IN [0..255];
  94.     Write(f1,Chr(x));
  95.   END;
  96.   Close(f1);
  97.   Close(f);
  98. END;
  99.  
  100. PROCEDURE Decodiere(passwort,source,ziel : String);
  101. VAR xx,yy,cc : STRING;
  102.     l : Integer;
  103. BEGIN
  104.   Öffnen(source, ziel);
  105.   code:=FormPasswort(passwort);
  106.   WHILE NOT Eof(f) DO
  107.   BEGIN
  108.     Read(f,c);
  109.     x:=Ord(c);
  110.     x:=x-code;
  111.     REPEAT
  112.      If x<0 Then x:=x+255;
  113.     UNTIL x IN [0..255];
  114.     Write(f1,Chr(x));
  115.   END;
  116.   Close(f1);
  117.   Close(f);
  118. END;
  119.  
  120. PROCEDURE Use;
  121. BEGIN
  122.   WriteLn;
  123.   WriteLn(un,fe,ora,"Cryptor V1.10 ",sc,"1993 by Björn Schotte",no);
  124.   WriteLn;
  125.   WriteLn(fe,"F R E E W A R E",no);
  126.   WriteLn;
  127.   WriteLn;
  128.   WriteLn(ku,"USAGE: ",no,ora,"Cryptor <Passwort> <d|k> <source> <ziel>");
  129.   WriteLn;
  130.   WriteLn(no,"d      : Dekodieren");
  131.   WriteLn("k      : Kodieren");
  132.   WriteLn("Source : Quelldatei");
  133.   WriteLn("Ziel   : Zieldatei");
  134.   HALT(0);
  135. END;
  136.  
  137. BEGIN
  138.   IF ParameterLen = 0 THEN Use;
  139.   IF ArgNum < 4 THEN Use;
  140.   FOR i := 1 To 4 DO args[i] := GetArg(i);
  141.   CASE args[2][1] OF
  142.     "d","D" : decode := True;
  143.     "k","K" : decode := False;
  144.   ELSE
  145.     Use;
  146.   END;
  147.   IF (decode = False) THEN Codiere(args[1],args[3],args[4])
  148.   ELSE Decodiere(args[1],args[3],args[4]);
  149. END.
  150.  
  151.  
  152.